home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PASCALL
/
TEMPJUNK
/
COLORS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-25
|
2KB
|
87 lines
program colors;
uses
crt,graph;
procedure setupgraph;
const
solidtype:fillpatterntype=($AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA);
var
graphdriver,graphmode:integer;
begin
graphdriver:=vga;
graphmode:=vgahi;
initgraph(graphdriver,graphmode,'c:\tp\bgi');
if graphresult<>grOk then halt;
cleardevice;
setfillstyle(solidfill,black);
setfillpattern(solidtype,black);
end;
procedure beamingcolors;
var
a:byte;
b:longint;
begin
for a:=0 to getmaxcolor do
begin
setcolor(a);
for b:=10*a to (a+1)*10 do circle(320,240,b);
end;
end;
procedure setpalettefirst;
var
palette:palettetype;
a:byte;
begin
getpalette(palette);
for a:=0 to palette.size-1 do palette.colors[a]:=a;
setallpalette(palette);
end;
procedure changepalette(var stop:boolean);
var
palette:palettetype;
a:word;
b:string;
txh,txw:integer;
begin
txh:=textheight('I'); txw:=textwidth('HHH');
getpalette(palette);
with palette do for a:=0 to size-1 do
begin
colors[a]:=colors[a]+8;
str(colors[a],b);
setcolor(white);
bar(txw*a,0,txw*(a+1),txh);
outtextxy(txw*a,1,b);
end;
if palette.colors[palette.size-1]>=127 then stop:=true else stop:=false;
setallpalette(palette);
end;
procedure control;
var
stop:boolean;
begin
setupgraph;
setpalettefirst;
beamingcolors;
repeat
{ readln;}
delay(50);
readln;
changepalette(stop);
until (stop) or (keypressed) ;
closegraph;
end;
begin
control;
end.